home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / timidsrc.zip / browser.tcl < prev    next >
Text File  |  1996-03-29  |  6KB  |  269 lines
  1. #----------------------------------------------------------------
  2. # file selection dialog
  3. # written by T.IWAI
  4. #----------------------------------------------------------------
  5.  
  6. #
  7. # filebrowser window-path current-directory filter-pattern create-flag
  8. #
  9. # The selected or input file name is returned.
  10. #
  11. proc filebrowser {w {curdir ""} {filter ""} {singlefile 0} {creatable 0}} {
  12.     global fs
  13.  
  14.     set fs(curdir) $curdir
  15.     set fs(filter) $filter
  16.     set fs(creatable) $creatable
  17.     set fs(found) ""
  18.  
  19.     fs:init $w
  20.     fs:update $w
  21.  
  22.     set oldFocus [focus]
  23.     grab $w
  24.     focus $w
  25.     tkwait window $w
  26.     focus $oldFocus
  27.  
  28.     return $fs(found)
  29. }
  30.  
  31.  
  32. #
  33. # create a filebrowser dialog
  34. #
  35. proc fs:init {w} {
  36.     global fs tk_priv
  37.     set f [my-dialog $w "File Selector" 0 1 [list\
  38.         [list {  OK  } "fs:select $w"]\
  39.         [list "Cancel" "destroy $w"]\
  40.         [list "Rescan" "fs:update $w"]\
  41.         [list { Select All } "fs:selall $w"]]]
  42.  
  43.     frame $f.filter
  44.     label $f.filter.label -text "Filter" -relief flat
  45.     entry $f.filter.entry -width 60 -relief sunken -textvariable fs(filter)
  46.     bind $f.filter.entry <Return> "focus $w; fs:update $w"
  47.     pack $f.filter.label $f.filter.entry -side top -anchor w
  48.  
  49.     frame $f.df
  50.     set fs(dirlist) [my-listbox $f.df.dir "Directories" 30x8]
  51.     set fs(filelist) [my-listbox $f.df.file "Files" 30x8 1 1]
  52.     pack $f.df.dir $f.df.file -side left -ipadx 2m
  53.  
  54.     frame $f.name
  55.     label $f.name.label -text "Name" -relief flat
  56.     entry $f.name.entry -width 60 -relief sunken -textvariable fs(curdir)
  57.     bind $f.name.entry <Return> "focus $w; fs:update $w"
  58.     pack $f.name.label $f.name.entry -side top -anchor w
  59.  
  60.     pack $f.filter $f.df $f.name -side top -pady 3m -fill x -padx 3m
  61.     
  62.     if {$tk_priv(new_tcltk)} {
  63.     bind $fs(filelist) <Button-1> "$fs(dirlist) select clear 0 end"
  64.     bind $fs(filelist) <Button-1> {+%W select anchor [%W nearest %y]}
  65.     bind $fs(dirlist) <Button-1> "$fs(filelist) select clear 0 end"
  66.     bind $fs(dirlist) <Button-1>  {+%W select anchor [%W nearest %y]}
  67.     } else {
  68.     bind $fs(filelist) <Button-1> "$fs(dirlist) select clear"
  69.     bind $fs(filelist) <Button-1> {+%W select from [%W nearest %y]}
  70.     bind $fs(dirlist) <Button-1> "$fs(filelist) select clear"
  71.     bind $fs(dirlist) <Button-1>  {+%W select from [%W nearest %y]}
  72.     }
  73.  
  74.  
  75.     bind $f.df.file.list <Double-1> [list fs:select $w]
  76.     bind $f.df.dir.list <Double-1> [list fs:changedir $w]
  77. }
  78.  
  79.  
  80. #
  81. # set up selection on the dir/file listboxes
  82. #
  83. proc fs:init-lbox {} {
  84.     global fs tk_priv
  85.     if {$tk_priv(new_tcltk)} {
  86.     $fs(dirlist) select clear 0 end
  87.     $fs(filelist) select set 0
  88.     } else {
  89.     $fs(dirlist) select clear
  90.     $fs(filelist) select from 0
  91.     $fs(filelist) select to 0
  92.     }
  93.     if {[lindex [$fs(filelist) curselection] 0] == ""} {
  94.     if {$tk_priv(new_tcltk)} {
  95.         $fs(filelist) select clear 0 end
  96.         $fs(dirlist) select set 0
  97.     } else {
  98.         $fs(filelist) select clear
  99.         $fs(dirlist) select from 0
  100.         $fs(dirlist) select to 0
  101.     }
  102.     }
  103. }
  104.  
  105. #
  106. # get the current listbox path
  107. #
  108. proc fs:get-cur-lbox {} {
  109.     global fs
  110.     if {[lindex [$fs(filelist) curselection] 0] != ""} {
  111.     return $fs(filelist)
  112.     } elseif {[lindex [$fs(dirlist) curselection] 0] != ""} {
  113.     return $fs(dirlist)
  114.     } else {
  115.     return ""
  116.     }
  117. }
  118.  
  119. #
  120. # select the file or directory
  121. #
  122. proc fs:select {w} {
  123.     global fs
  124.     set curw [fs:get-cur-lbox]
  125.     if {$curw == $fs(filelist)} {
  126.     set idxlist [$fs(filelist) curselection]
  127.     if {[llength $idxlist] > 0} {
  128.         set fs(found) {}
  129.         foreach idx $idxlist {
  130.         set i [$fs(filelist) get $idx]
  131.         if {$fs(curdir) != ""} {
  132.             lappend fs(found) $fs(curdir)/$i
  133.         } else {
  134.             lappend fs(found) $i
  135.         }
  136.         }
  137.         destroy $w
  138.     }
  139.     } elseif {$curw == $fs(dirlist)} {
  140.     fs:changedir $w
  141.     }
  142. }
  143.  
  144. #
  145. # select all files
  146. #
  147. proc fs:selall {w} {
  148.     global fs
  149.     set size [$fs(filelist) size]
  150.     if {$size > 0} {
  151.     set fs(found) {}
  152.     for {set idx 0} {$idx < $size} {incr idx} {
  153.         set i [$fs(filelist) get $idx]
  154.         if {$fs(curdir) != ""} {
  155.         lappend fs(found) $fs(curdir)/$i
  156.         } else {
  157.         lappend fs(found) $i
  158.         }
  159.     }
  160.     destroy $w
  161.     }
  162. }
  163.  
  164. #
  165. # go up to the parent directory
  166. #
  167. proc fs:updir {} {
  168.     global fs
  169.     if [regexp "^/.+" $fs(curdir)] {
  170.     if {[regsub "/\[^/\]+$" $fs(curdir) "" newdir] && $newdir != ""} {
  171.         set fs(curdir) $newdir
  172.     } else {
  173.         set fs(curdir) "/"
  174.     }
  175.     } else {
  176.     if [regsub "/\[^/\]+$" $fs(curdir) "" newdir] {
  177.         set fs(curdir) $newdir
  178.     } elseif [regexp "~.\[^/\]+" $fs(curdir)] {
  179.         set fs(curdir) [glob -nocomplain $fs(curdir)]
  180.         fs:updir
  181.     } elseif {$fs(curdir) != "" && $fs(curdir) != "."} {
  182.         set fs(curdir) ""
  183.     } elseif {$fs(curdir) == "" || $fs(curdir) == "."} {
  184.         set fs(curdir) [pwd]
  185.         fs:updir
  186.     }
  187.     }
  188. }
  189.  
  190. #
  191. # change to the selected directory
  192. #
  193. proc fs:changedir {w} {
  194.     global fs
  195.     set idx [lindex [$fs(dirlist) curselection] 0]
  196.     if {$idx != ""} {
  197.     set i [$fs(dirlist) get $idx]
  198.     global fs
  199.     if {$i == ".."} {
  200.         fs:updir
  201.     } else {
  202.         if {$fs(curdir) != ""} {
  203.         set fs(curdir) $fs(curdir)/$i
  204.         } else {
  205.         set fs(curdir) $i
  206.         }
  207.     }
  208.     fs:update $w
  209.     }
  210. }
  211.  
  212. #
  213. # scan files and directories
  214. #
  215. proc fs:update {w} {
  216.     global fs
  217.  
  218.     if ![file isdirectory $fs(curdir)] {
  219.     if {[file exists $fs(curdir)] || $fs(creatable)} {
  220.         set fs(found) $fs(curdir)
  221.         destroy $w
  222.         return
  223.     }
  224.     }
  225.  
  226.     set dir $fs(dirlist)
  227.     set file $fs(filelist)
  228.     
  229.     $dir delete 0 end
  230.     $file delete 0 end
  231.  
  232.     if {$fs(filter) != ""} {
  233.     set filter $fs(filter)
  234.     } else {
  235.     set filter "*"
  236.     }
  237.  
  238.     set lookall "*"
  239.     if {$fs(curdir) != ""} {
  240.     set patbase "$fs(curdir)/"
  241.     } else {
  242.     set patbase ""
  243.     }
  244.  
  245.     foreach i [glob -nocomplain $patbase$filter] {
  246.     if ![regexp "^.*/(\[^/\]+)$" $i full base] {
  247.         set base $i
  248.     }
  249.     if {$base != "" && ![file isdirectory $i]} {
  250.         $file insert end $base
  251.     }
  252.     }
  253.  
  254.     set prev ".."
  255.     $dir insert end $prev
  256.     foreach i [lsort [glob -nocomplain $patbase$lookall $patbase$filter]] {
  257.     if {$i == $prev} {continue}
  258.     if ![regexp "^.*/(\[^/\]+)$" $i full base] {
  259.         set base $i
  260.     }
  261.     if {$base != "" && [file isdirectory $i]} {
  262.         $dir insert end $base
  263.     }
  264.     }
  265.  
  266.     fs:init-lbox
  267. }
  268.  
  269.